      SUBROUTINE BUDGET5  
C  
C **  ADDED BY DON KINGERY, CH2M-HILL ON 15 OCTOBER 1996  
C CHANGE RECORD  
C **  SUBROUTINES BUDGETN CALCULATE SEDIMENT BUDGET (TOTAL SEDIMENTS)  
C  
      USE GLOBAL  
	IMPLICIT NONE
	INTEGER::NS,L,K
	REAL::SEDBTMP1,SEDBTMP,SFLXTMP,BSEDERR,SSEDOUT,BSEDOUT,SSEDERE
	REAL::BSEDERE,SSEDBMO,BSEDBMO,SSEDERR,SDFLUX,VOLMBMO
	REAL::SMASSBMO,VOLMERR,SMASSERR
C  
C **  CHECK FOR END OF BALANCE PERIOD  
C  
      IF(NBUD.EQ.NTSMMT)THEN  
 6666 FORMAT(' ACTIVE CALL TO BUDGET5, N,NBUD = ',2I5)  
C  
C **  CALCULATE ENDING SUSPENDED AND BOTTOM SEDIMENT IN THE MODEL DOMAIN  
C  
        SDFLUX=0.  
        SSEDEND=0.  
        BSEDEND=0.  
        VOLMEND=0.  
        SMASSEND=0.  
        IF(N.EQ.NTSMMT)THEN  
          DO L=2,LA  
            VOLMEND=VOLMEND+SPB(L)*DXYP(L)*H1P(L)  
          ENDDO  
        ELSE  
          DO L=2,LA  
            VOLMEND=VOLMEND+SPB(L)*DXYP(L)*HP(L)  
          ENDDO  
        ENDIF  
        IF(N.EQ.NTSMMT)THEN  
          DO K=1,KC  
            DO L=2,LA  
              SMASSEND=SMASSEND+SCB(L)*DXYP(L)*H1P(L)*SAL1(L,K)*DZC(K)  
            ENDDO  
          ENDDO  
        ELSE  
          DO K=1,KC  
            DO L=2,LA  
              SMASSEND=SMASSEND+SCB(L)*DXYP(L)*HP(L)*SAL(L,K)*DZC(K)  
            ENDDO  
          ENDDO  
        ENDIF  
C  
C  INITIALIZE BOTTOM AND SUSPENDED SEDIMENT MASS  ---  DLK 9/26  
C  
        DO L=2,LA  
          SDFLUX=SDFLUX+SCB(L)*VOLBW3(L,KB)  
        ENDDO  
        DO K=1,KB  
          DO L=2,LA  
            SEDBT(L,K)=0.  
            SNDBT(L,K)=0.  
          ENDDO  
        ENDDO  
        IF(N.EQ.NTSMMT)THEN  
          DO NS=1,NSED  
            DO K=1,KB  
              DO L=2,LA  
                SEDBT(L,K)=SEDBT(L,K)+SCB(L)*SEDB1(L,K,NS)  
              ENDDO  
            ENDDO  
          ENDDO  
          DO NS=1,NSND  
            DO K=1,KB  
              DO L=2,LA  
                SNDBT(L,K)=SNDBT(L,K)+SCB(L)*SNDB1(L,K,NS)  
              ENDDO  
            ENDDO  
          ENDDO  
        ELSE  
          DO NS=1,NSED  
            DO K=1,KB  
              DO L=2,LA  
                SEDBT(L,K)=SEDBT(L,K)+SCB(L)*SEDB(L,K,NS)  
              ENDDO  
            ENDDO  
          ENDDO  
          DO K=1,KB  
            DO NS=1,NSND  
              DO L=2,LA  
                SNDBT(L,K)=SNDBT(L,K)+SCB(L)*SNDB(L,K,NS)  
              ENDDO  
            ENDDO  
          ENDDO  
        ENDIF  
        DO K=1,KB  
          DO L=2,LA  
            BSEDEND=BSEDEND+SCB(L)*DXYP(L)*(SEDBT(L,K)+SNDBT(L,K))  
          ENDDO  
        ENDDO  
        IF(N.EQ.NTSMMT)THEN  
          DO NS=1,NSED  
            DO K=1,KC  
              DO L=2,LA  
               SSEDEND=SSEDEND+SCB(L)*DXYP(L)*H1P(L)*SED1(L,K,NS)*DZC(K)  
              ENDDO  
            ENDDO  
          ENDDO  
          DO NS=1,NSND  
            DO K=1,KC  
              DO L=2,LA  
               SSEDEND=SSEDEND+SCB(L)*DXYP(L)*H1P(L)*SND1(L,K,NS)*DZC(K)  
              ENDDO  
            ENDDO  
          ENDDO  
        ELSE  
          DO NS=1,NSED  
            DO K=1,KC  
              DO L=2,LA  
                SSEDEND=SSEDEND+SCB(L)*DXYP(L)*HP(L)*SED(L,K,NS)*DZC(K)  
              ENDDO  
            ENDDO  
          ENDDO  
          DO NS=1,NSND  
            DO K=1,KC  
              DO L=2,LA  
                SSEDEND=SSEDEND+SCB(L)*DXYP(L)*HP(L)*SND(L,K,NS)*DZC(K)  
              ENDDO  
            ENDDO  
          ENDDO  
        ENDIF  
        SEDEND=SSEDEND+BSEDEND  
        SEDOUT=DT*SEDOUT  
        SEDIN=DT*SEDIN  
        VOLMOUT=DT*VOLMOUT  
        VOLMIN=DT*VOLMIN  
        SMASSIN=DT*SMASSIN  
        SMASSOUT=DT*SMASSOUT  
        SDFLUX=DT*SDFLUX  
        SEDBMO=SEDBEG+SEDIN-SEDOUT  
        VOLMBMO=VOLMBEG+VOLMIN-VOLMOUT  
        SMASSBMO=SMASSBEG+SMASSIN-SMASSOUT  
        SEDERR=SEDEND-SEDBMO  
        VOLMERR=VOLMEND-VOLMBMO  
        SMASSERR=SMASSEND-SMASSBMO  
        RSDERDE=-9999.  
        RSDERDO=-9999.  
        IF(SEDEND.NE.0.) RSDERDE=SEDERR/SEDEND  
        IF(SEDOUT.NE.0.) RSDERDO=SEDERR/(SEDIN+SEDOUT)  
C  
C **  OUTPUT BALANCE RESULTS TO FILE BUDGET.OUT  
C  
        IF(JSSBAL.EQ.1)THEN  
          OPEN(89,FILE='BUDGET.OUT',STATUS='UNKNOWN')  
          OPEN(93,FILE='BUDGET2.OUT',STATUS='UNKNOWN')  
          OPEN(94,FILE='BUDGET3.OUT',STATUS='UNKNOWN')  
          CLOSE(89,STATUS='DELETE')  
          CLOSE(93,STATUS='DELETE')  
          CLOSE(94,STATUS='DELETE')  
          OPEN(89,FILE='BUDGET.OUT',STATUS='UNKNOWN')  
          WRITE(89,888)NTSMMT,TBEGIN  
          OPEN(93,FILE='BUDGET2.OUT',STATUS='UNKNOWN')  
          WRITE(93,893)NTSMMT,TBEGIN  
          OPEN(94,FILE='BUDGET3.OUT',STATUS='UNKNOWN')  
          WRITE(94,894)NTSMMT,TBEGIN  
          JSSBAL=0  
        ELSE  
          OPEN(89,FILE='BUDGET.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
          OPEN(93,FILE='BUDGET2.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
          OPEN(94,FILE='BUDGET3.OUT',POSITION='APPEND',STATUS='UNKNOWN')  
        ENDIF  
        WRITE(89,892)N,BSEDBEG,SSEDBEG,SEDIN,SEDOUT,SEDBMO,BSEDEND,  
     &      SSEDEND,SEDERR,RSDERDE,RSDERDO  
        WRITE(93,895)N,VOLMBEG,VOLMIN,VOLMOUT,VOLMBMO,VOLMEND,VOLMERR  
        WRITE(94,895)N,SMASSBEG,SMASSIN,SMASSOUT,SMASSBMO,SMASSEND,  
     &      SMASSERR  
        SSEDBMO=SSEDBEG+SEDIN-SEDOUT+SDFLUX  
        BSEDBMO=BSEDBEG-SDFLUX  
        SSEDERR=SSEDEND-SSEDBMO  
        BSEDERR=BSEDEND-BSEDBMO  
        SSEDOUT=SEDOUT-SEDIN-SDFLUX  
        BSEDOUT=SDFLUX  
        SSEDBMO=SSEDBEG-SSEDOUT  
        BSEDBMO=BSEDBEG-BSEDOUT  
        SSEDERR=SSEDEND-SSEDBMO  
        BSEDERR=BSEDEND-BSEDBMO  
        IF(SSEDEND.NE.0.)SSEDERE=SSEDERR/SSEDEND  
        IF(BSEDEND.NE.0.)BSEDERE=BSEDERR/BSEDEND  
        DO L=2,LA  
          VOLBW3(L,KB)=DT*VOLBW3(L,KB)  
          SEDBTMP1=DXYP(L)*SEDB1(L,KBT(L),1)  
          SEDBTMP=DXYP(L)*SEDB(L,KB,1)  
          SFLXTMP=DT*DXYP(L)*SEDF(L,0,1)  
        ENDDO  
        CLOSE(89)  
        CLOSE(93)  
        CLOSE(94)  
 9510 FORMAT(//' SUS AND BED SED BUDGET ENDING AT N =',I7/)  
 9511 FORMAT(' SEDIN,SEDOUT,SDFLUX = ',3E15.7/)  
 9512 FORMAT(' SSEDBEG,BSEDBEG = ',2E15.7/)  
 9513 FORMAT(' SSEDOUT,BSEDOUT = ',2E15.7/)  
 9514 FORMAT(' SSEDBMO,BSEDBMO = ',2E15.7/)  
 9515 FORMAT(' SSEDEND,BSEDEND = ',2E15.7/)  
 9516 FORMAT(' SSEDERR,BSEDERR = ',2E15.7/)  
 9517 FORMAT(' SSEDERE,BSEDERE = ',2E15.7/)  
 9600 FORMAT(/'C ACCUMULATED SED FLUX AT N = ',I5)  
 9601 FORMAT(2I5,5E15.7)  
  888 FORMAT (6X,' SEDIMENT BUDGET CALCULATIONS'//  
     &    6X,'SEDIMENT BUDGET OVER ',I5,' TIME STEPS'/  
     &    6X,'STARTING ON JULIAN DAY ',F6.2/  
     &    6X,'N       = LAST TIME STEP IN PERIOD'/  
     &    6X,'BSEDBEG  = TOTAL BED SEDIMENT IN MODEL DOMAIN 
     &    AT BEGINNING',' OF TIME PERIOD'/  
     &    6X,'SSEDBEG  = TOTAL SUSPENDED SEDIMENT IN MODEL DOMAIN AT',  
     &    ' BEGINNING OF TIME PERIOD'/  
     &    6X,'SEDIN   = SEDIMENT ADDED TO MODEL FROM OUTFALL'/  
     &    6X,'SEDOUT  = SEDIMENT REMOVED ACROSS MODEL BOUNDARIES'/  
     &    6X,'SEDBMO  = SEDBEG+SEDIN-SEDOUT'/  
     &    6X,'SEDEND  = SEDIMENT REMAINING IN MODEL DOMAIN'/  
     &    6X,'SEDERR  = SEDEND-SEDBMO'/  
     &    6X,'RSDERDE = ERROR AS A FRACTION OF SEDIMENT IN 
     & MODEL DOMAIN'/6X,'RSDERDO = ERROR AS A FRACTION OF 
     & SEDIMENT ADDED/REMOVED'//1X,'       N         BSEDBEG        
     &  SSEDBEG        SEDIN',1X,'          SEDOUT          SEDBMO    
     &  ',1X,'    BSEDEND          SSEDEND          SEDERR       
     &  RSDERDE',1X,'         RSDERDO'/)  
  892 FORMAT (1X,I9,10(2X,E14.6))  
  893 FORMAT (6X,' MASS BALANCE CALCULATIONS'//  
     &    6X,'MASS BALANCE OVER ',I5,' TIME STEPS'/  
     &    6X,'STARTING ON JULIAN DAY ',F6.2/  
     &    6X,'N       = LAST TIME STEP IN PERIOD'/  
     &    6X,'VOLMBEG = TOTAL WATER VOLUME IN MODEL DOMAIN 
     &    AT BEGINNING',' OF TIME PERIOD'/  
     &    6X,'VOLMIN  = WATER VOLUME ADDED TO MODEL FROM INFLOWS'/  
     &    6X,'VOLMOUT = WATER VOLUME REMOVED ACROSS MODEL BOUNDARIES'/  
     &    6X,'VOLMBMO = VOLMBEG-(VOLMIN+VOLMOUT)'/  
     &    6X,'VOLMEND = WATER VOLUME REMAINING IN MODEL DOMAIN'/  
     &    6X,'VOLMERR = VOLMEND-VOLMBMO'//  
     &    1X,'       N         VOLMBEG        VOLMIN         VOLMOUT',  
     &    1X,'        VOLMBMO        VOLMEND          VOLMERR'/)  
  894 FORMAT (6X,' SALT BALANCE CALCULATIONS'//  
     &    6X,'SALT BALANCE OVER ',I5,' TIME STEPS'/  
     &    6X,'STARTING ON JULIAN DAY ',F6.2/  
     &    6X,'N        = LAST TIME STEP IN PERIOD'/  
     &    6X,'SMASSBEG = TOTAL WATER VOLUME IN MODEL DOMAIN 
     &    AT BEGINNING',' OF TIME PERIOD'/  
     &    6X,'SMASSIN  = WATER VOLUME ADDED TO MODEL FROM INFLOWS'/  
     &    6X,'SMASSOUT = WATER VOLUME REMOVED ACROSS MODEL BOUNDARIES'/  
     &    6X,'SMASSBMO = VOLMBEG-(VOLMIN+VOLMOUT)'/  
     &    6X,'SMASSEND = WATER VOLUME REMAINING IN MODEL DOMAIN'/  
     &    6X,'SMASSERR = VOLMEND-VOLMBMO'//  
     &    1X,'       N        SMASSBEG       SMASSIN        SMASSOUT',  
     &    1X,'       SMASSBMO       SMASSEND         SMASSERR'/)  
  895 FORMAT (1X,I9,6(2X,E14.6))  
        NBUD=0  
      ENDIF  
      NBUD=NBUD+1  
      RETURN  
      END  

